home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / Bonus / DBaldwin / litebrows.exe / LiteBrows.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-25  |  9.5 KB  |  362 lines
  1.  
  2. {
  3. This is a simple browser demo using the ThtmlLite HTML display component and the
  4. Internet Direct (Indy) internet components.  The Indy components come with
  5. Delphi 6.  To compile this demo using Delphi 4 or 5, you will need
  6. to download and install the Indy components.  They are available (no charge) at
  7. http://www.nevrona.com/Indy/.
  8.  
  9. This is a very basic demo designed to illustrate downloading and displaying an
  10. HTML document and its images.  It demostrates the use of ThtmlLite's
  11. OnImageRequest event and InsertImage method to handle the image downloading.
  12. To keep things simple, many browser nicities (requirements) have been omitted,
  13. such as:
  14.  
  15.   Form submission
  16.   Non HTML downloads (zip files, etc)
  17.   Disk Caching (although images are cached)
  18.   Proxies
  19.   History list
  20.   Cookies
  21.   Frames
  22.  
  23. For examples that cover the above, see the demo program for the
  24. TFrameBrowser component available at www.pbear.com, filename brzdemoXXX.zip.
  25. }
  26.  
  27. unit LiteBrows;
  28.  
  29. interface
  30.  
  31. uses
  32.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  33.   Gauges, HTMLLite, StdCtrls, Buttons, ExtCtrls, UrlSubs, 
  34.   IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
  35.   IdTCPConnection, IdTCPClient, IdHTTP, ToolWin, ComCtrls, ImgList;
  36.  
  37. const
  38.   wm_LoadURL = wm_User+124;
  39.   wm_DoImages = wm_User+127;
  40.  
  41. type
  42.   THTTPForm = class(TForm)
  43.     Viewer: ThtmlLite;
  44.     Panel20: TPanel;
  45.     Status3: TPanel;
  46.     Status2: TPanel;
  47.     IdHTTP: TIdHTTP;
  48.     IdAntiFreeze1: TIdAntiFreeze;
  49.     CoolBar1: TCoolBar;
  50.     UrlCombobox: TComboBox;
  51.     ToolBar1: TToolBar;
  52.     BackButton: TToolButton;
  53.     ForwardButton: TToolButton;
  54.     Panel1: TPanel;
  55.     ToolBar2: TToolBar;
  56.     GoButton: TToolButton;
  57.     AbortButton: TToolButton;
  58.     Panel2: TPanel;
  59.     ImageList1: TImageList;
  60.     Animate: TAnimate;
  61.     Status1: TPanel;
  62.     Gauge: TGauge;
  63.     procedure GoButtonClick(Sender: TObject);
  64.     procedure ViewerImageRequest(Sender: TObject; const SRC: String;
  65.       var Stream: TMemoryStream);
  66.     procedure FormCreate(Sender: TObject);
  67.     procedure FormDestroy(Sender: TObject);
  68.     procedure URLComboBoxKeyPress(Sender: TObject; var Key: Char);
  69.     procedure ViewerHotSpotClick(Sender: TObject; const SRC: String;
  70.       var Handled: Boolean);
  71.     procedure AbortButtonClick(Sender: TObject);
  72.     procedure ViewerHotSpotCovered(Sender: TObject; const SRC: String);
  73.     procedure BackButtonClick(Sender: TObject);
  74.     procedure ForwardButtonClick(Sender: TObject);
  75.     procedure UrlComboboxClick(Sender: TObject);
  76.     procedure IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode;
  77.       const AWorkCount: Integer);
  78.     procedure IdHTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  79.       const AWorkCountMax: Integer);
  80.   private
  81.     { Private declarations }
  82.     UrlBase: string;
  83.     NewLoadUrl: string;
  84.     ImageList: TStringList;    {a list of images to load}
  85.     MStream: TMemoryStream;
  86.     NumImageTot, NumImageDone: integer;
  87.     WorkCountMax: integer;
  88.     procedure LoadViewer(const Url: string);
  89.     procedure WMDoImages(var Message: TMessage); message WM_DoImages;
  90.     procedure WMLoadURL(var Message: TMessage); message WM_LoadURL;
  91.     procedure CheckEnableControls;
  92.     procedure DisableControls;
  93.     procedure EnableControls;
  94.     function GetStream(const Url: string): TMemoryStream;
  95.     procedure Progress(Num, Den: integer);
  96.   public
  97.     { Public declarations }
  98.   end;
  99.  
  100. var
  101.   HTTPForm: THTTPForm;
  102.  
  103. implementation
  104.  
  105. uses LiteUn2;   {for WaitStream definition}
  106.  
  107. {$R *.DFM}
  108.  
  109. procedure THTTPForm.FormCreate(Sender: TObject);
  110. begin
  111. if Screen.Width <= 800 then   {make window fit appropriately}
  112.   begin
  113.   Left := Left div 2;
  114.   Width := (Screen.Width * 9) div 10;
  115.   Height := (Screen.Height * 7) div 8;
  116.   end
  117. else
  118.   begin
  119.   Width := 850;
  120.   Height := 600;
  121.   end;
  122. ImageList := TStringList.Create;
  123. MStream := TMemoryStream.Create;
  124. end;
  125.  
  126. procedure THTTPForm.FormDestroy(Sender: TObject);
  127. begin
  128. ImageList.Free;
  129. MStream.Free;
  130. end;
  131.  
  132. function THTTPForm.GetStream(Const Url: string): TMemoryStream;
  133. {download an HTML document or image.  Return it in stream form}
  134. begin
  135. MStream.Clear;
  136. try
  137.   IdHTTP.Get(Url, MStream);
  138. except
  139.   MStream.Clear;
  140.   end;
  141. Result := MStream;
  142. end;
  143.  
  144. procedure THTTPForm.GoButtonClick(Sender: TObject);
  145. {initiate loading of a main document}
  146. var
  147.   Url: string;
  148. begin
  149. Url := Normalize(URLCombobox.Text);   {put in standard form}
  150. DisableControls;
  151. Status2.Caption := '';
  152. NumImageTot := 0;
  153. NumImageDone := 0;
  154. Progress(0, 0);
  155. Gauge.Visible := True;
  156. try
  157.   Animate.Active := True;
  158.   Animate.Visible := True;
  159.   IdHTTP.OnWork := IdHTTPWork;
  160.   LoadViewer(URL);
  161.   URLBase := GetBase(URL);   {save the base directory}
  162.   if URLComboBox.Items.IndexOf(URL) = -1 then
  163.     begin
  164.     URLComboBox.Items.Add(URL);
  165.     URLComboBox.ItemIndex := URLComboBox.Items.Count-1;
  166.     end;
  167. finally
  168.   IdHTTP.OnWork := Nil;
  169.   CheckEnableControls;
  170.   Viewer.SetFocus;
  171.   end;
  172. end;
  173.  
  174. procedure THTTPForm.LoadViewer(const Url: string);
  175. var
  176.   Url1, Dest: string;
  177.   I: integer;
  178.   Stream: TMemoryStream;
  179. begin
  180. DisableControls;
  181. Url1 := URL;
  182. I := Pos('#', Url1);  {see if Url has local destination part}
  183. if I >= 1 then
  184.   begin
  185.   Dest := System.Copy(Url1, I, Length(Url1)-I+1);  {local destination}
  186.   Url1 := System.Copy(Url1, 1, I-1);     {document Url}
  187.   end
  188. else
  189.   Dest := '';    {no local destination}
  190. Stream := GetStream(Url1);   {do the download}
  191. {while Viewer is being loaded, a series of OnImageRequest events will occur.
  192.  see ViewerImageRequest below}
  193. Viewer.LoadFromStream(Stream);
  194. if Dest <> '' then
  195.   Viewer.PositionTo(Dest);
  196. end;
  197.  
  198. procedure THTTPForm.ViewerImageRequest(Sender: TObject; const SRC: String;
  199.   var Stream: TMemoryStream);
  200. {the OnImageRequest handler}
  201. begin
  202. Stream := WaitStream;   {wait indicator, means image will be inserted later}
  203. ImageList.Add(SRC);    {add to list of images to download}
  204. Inc(NumImageTot);
  205. if ImageList.Count = 1 then
  206.   PostMessage(Handle, wm_DoImages, 0, 0);
  207. end;
  208.  
  209. procedure THTTPForm.WMDoImages(var Message: TMessage);
  210. {loop through the ImageList to download and insert the images}
  211. var
  212.   S, Src: string;
  213. begin
  214. if ImageList.Count > 0 then
  215.   begin
  216.   Src := ImageList[0];
  217.   ImageList.Delete(0);
  218.   if not IsFullUrl(Src) then
  219.     S := Combine(UrlBase, Src)
  220.   else S := Src;
  221.   Viewer.InsertImage(Src, GetStream(S));
  222.   Inc(NumImageDone);
  223.   Progress(NumImageDone, NumImageTot);
  224.   if ImageList.Count > 0 then
  225.     PostMessage(Handle, wm_DoImages, 0, 0) {more to do}
  226.   else CheckEnableControls;
  227.   end;
  228. end;
  229.  
  230. procedure THTTPForm.URLComboBoxKeyPress(Sender: TObject; var Key: Char);
  231. {trap CR in combobox}
  232. begin
  233. if (Key = #13) and (URLComboBox.Text <> '') then
  234.   Begin
  235.   Key := #0;
  236.   GoButtonClick(Self);
  237.   end;
  238. end;
  239.  
  240. procedure THTTPForm.ViewerHotSpotClick(Sender: TObject; const Src: String;
  241.   var Handled: Boolean);
  242. {the OnHotspotClick event handler, a link has been clicked}
  243. begin
  244. if (Length(Src) > 0) and (Src[1] = '#') then
  245.   begin   {it's a local jump}
  246.   Handled := False;
  247.   Exit;
  248.   end;
  249.  
  250. if not IsFullUrl(Src) then
  251.   NewLoadUrl := Combine(UrlBase, Src)
  252. else NewLoadUrl := Src;
  253.  
  254. if GetProtocol(NewLoadUrl) = 'http' then
  255.   begin
  256.   {download can't be done here.  Post a message to do it later at WMLoadUrl}
  257.   PostMessage(handle, wm_LoadUrl, 0, 0);
  258.   Handled := True;
  259.   end
  260. else Handled := False;
  261. end;
  262.  
  263. procedure THTTPForm.WMLoadURL(var Message: TMessage);
  264. begin
  265. UrlCombobox.Text := NewLoadUrl;
  266. GoButtonClick(Self);
  267. end;
  268.  
  269. procedure THTTPForm.AbortButtonClick(Sender: TObject);
  270. begin
  271. IdHTTP.DisconnectSocket;
  272. ImageList.Clear;
  273. CheckEnableControls;
  274. end;
  275.  
  276. procedure THTTPForm.CheckEnableControls;
  277. begin
  278. if ImageList.Count = 0 then
  279.   begin
  280.   EnableControls;
  281.   Animate.Active := False;
  282.   Animate.Visible := False;
  283.   Status2.Caption   := 'DONE';
  284.   end;
  285. end;
  286.  
  287. procedure THTTPForm.DisableControls;
  288. begin
  289.   URLCombobox.Enabled:=false;
  290.   BackButton.Enabled := False;
  291.   ForwardButton.Enabled := False;
  292.   GoButton.Enabled := False;
  293.   AbortButton.Enabled:=true;
  294. end;
  295.  
  296. procedure THTTPForm.EnableControls;
  297. begin
  298.   URLCombobox.Enabled:=true;
  299.   BackButton.Enabled := URLComboBox.ItemIndex > 0;
  300.   ForwardButton.Enabled := URLComboBox.ItemIndex <= URLComboBox.Items.Count-2;
  301.   AbortButton.Enabled:=false;
  302.   Gauge.Visible := False;
  303.   GoButton.Enabled := True;
  304. end;
  305.  
  306. procedure THTTPForm.ViewerHotSpotCovered(Sender: TObject;
  307.   const SRC: String);
  308. {mouse moved over or away from a link.  Change the status line}
  309. begin
  310.   Status3.Caption := SRC;
  311. end;
  312.  
  313. procedure THTTPForm.BackButtonClick(Sender: TObject);
  314. begin
  315.   if URLComboBox.ItemIndex <= 0 then
  316.     exit;
  317.   AbortButton.Click;
  318.   URLComboBox.ItemIndex := URLComboBox.ItemIndex-1;
  319.   GoButton.Click;
  320. end;
  321.  
  322. procedure THTTPForm.ForwardButtonClick(Sender: TObject);
  323. begin
  324.   if URLComboBox.ItemIndex = URLComboBox.Items.Count - 1 then
  325.     exit;
  326.   AbortButton.Click;
  327.   URLComboBox.ItemIndex := URLComboBox.ItemIndex+1;
  328.   GoButton.Click;
  329. end;
  330.  
  331. procedure THTTPForm.UrlComboboxClick(Sender: TObject);
  332. begin
  333. GoButton.Click;
  334. end;
  335.  
  336. procedure THTTPForm.Progress(Num, Den: integer);
  337. var
  338.   Percent: integer;
  339. begin
  340. if Den = 0 then Percent := 0
  341. else
  342.   Percent := (100*Num) div Den;
  343. Gauge.Progress := Percent;
  344. Gauge.Update;
  345. end;
  346.  
  347. procedure THTTPForm.IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode;
  348.   const AWorkCount: Integer);
  349. begin
  350. Status1.Caption := 'Text: ' + IntToStr(AWorkCount) + ' bytes';
  351. Status1.Update;
  352. Progress(AWorkCount, WorkCountMax);
  353. end;
  354.  
  355. procedure THTTPForm.IdHTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  356.   const AWorkCountMax: Integer);
  357. begin
  358. WorkCountMax := AWorkCountMax;
  359. end;
  360.  
  361. end.
  362.